Raport przedstawia analizę możliwych przyczyn karłowacenia śledzia oceanicznego wyławianego w Europie.
Jest wiele powodów, dlaczego śledzie oceaniczne w Europie maleją. Poniższy raport przedstawia najbardziej prawdopodobne hipotezy, opierając się na zebranych danych. Zmiana temperatury przy powierzchni wody oraz intensywność połowów przez człowieka okazały się najbardziej istotne. Zaprezentowany w analizie regresor dobrze poradził sobie z zadaniem. Model pozwala w zadowalający sposób przewidzieć długość śledzia dla danych wartości atrybutów. W celu uzyskania bardziej obiektywnych rezultatów analizy, należałoby zebrać więcej obserwacji oraz uzupełnić je o czas pomiaru oraz dodatkowe atrybuty. Jakość pomiarów w wielu przypadkach nie jest również odpowiednio dokładna, ponieważ większość atrybutów posiada jedynie około 50 różnych wartości.
W celu wykonania analizy zostało użytych wiele bibliotek:
library(knitr)
library(dplyr)
library(ggplot2)
library(caret)
library(kableExtra)
library(tidyr)
library(tidyverse)
library(plotly)
W celu uzyskania takich samych rezultatów przy ponownych wykonaniach skryptu na tych samych danych, ustalono ziarno na losową liczbę.
set.seed(23)
Dane znajdują się w jednym pliku formatu csv - ‘sledzie.csv’. Wartości puste zostały reprezentowane poprzez znak ‘?’.
sledzie_df <- read.csv(
"sledzie.csv",
col.names = c("lp", "length", "cfin1", "cfin2", "chel1", "chel2", "lcop1", "lcop2", "fbar", "recr", "cumf", "totaln", "sst", "sal", "xmonth", "nao"),
na.strings = "?"
)
sledzie_df <- sledzie_df[-c(1)]
sledzie_df <- tbl_df(sledzie_df)
W poniższej tabeli zaprezentowanych zostało kilka pierwszych rekordów zbioru:
| length | cfin1 | cfin2 | chel1 | chel2 | lcop1 | lcop2 | fbar | recr | cumf | totaln | sst | sal | xmonth | nao |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 23.0 | 0.02778 | 0.27785 | 2.46875 | NA | 2.54787 | 26.35881 | 0.356 | 482831 | 0.3059879 | 267380.8 | 14.30693 | 35.51234 | 7 | 2.8 |
| 22.5 | 0.02778 | 0.27785 | 2.46875 | 21.43548 | 2.54787 | 26.35881 | 0.356 | 482831 | 0.3059879 | 267380.8 | 14.30693 | 35.51234 | 7 | 2.8 |
| 25.0 | 0.02778 | 0.27785 | 2.46875 | 21.43548 | 2.54787 | 26.35881 | 0.356 | 482831 | 0.3059879 | 267380.8 | 14.30693 | 35.51234 | 7 | 2.8 |
| 25.5 | 0.02778 | 0.27785 | 2.46875 | 21.43548 | 2.54787 | 26.35881 | 0.356 | 482831 | 0.3059879 | 267380.8 | 14.30693 | 35.51234 | 7 | 2.8 |
| 24.0 | 0.02778 | 0.27785 | 2.46875 | 21.43548 | 2.54787 | 26.35881 | 0.356 | 482831 | 0.3059879 | 267380.8 | 14.30693 | 35.51234 | 7 | 2.8 |
| 22.0 | 0.02778 | 0.27785 | 2.46875 | 21.43548 | 2.54787 | NA | 0.356 | 482831 | 0.3059879 | 267380.8 | 14.30693 | 35.51234 | 7 | 2.8 |
| 24.0 | 0.02778 | 0.27785 | 2.46875 | 21.43548 | 2.54787 | 26.35881 | 0.356 | 482831 | 0.3059879 | 267380.8 | 14.30693 | 35.51234 | 7 | 2.8 |
| 23.5 | 0.02778 | 0.27785 | 2.46875 | 21.43548 | 2.54787 | 26.35881 | 0.356 | 482831 | 0.3059879 | 267380.8 | 14.30693 | 35.51234 | 7 | 2.8 |
W celu zapewnienia poprawnych wyników obliczeń, zdecydowano się na usunięcie rekordów zawierających brakujące wartości.
sledzie_df <- na.omit(sledzie_df)
kable(head(sledzie_df, 8)) %>%
kable_styling("striped") %>%
scroll_box(height="360px")
| length | cfin1 | cfin2 | chel1 | chel2 | lcop1 | lcop2 | fbar | recr | cumf | totaln | sst | sal | xmonth | nao |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 22.5 | 0.02778 | 0.27785 | 2.46875 | 21.43548 | 2.54787 | 26.35881 | 0.356 | 482831 | 0.3059879 | 267380.8 | 14.30693 | 35.51234 | 7 | 2.8 |
| 25.0 | 0.02778 | 0.27785 | 2.46875 | 21.43548 | 2.54787 | 26.35881 | 0.356 | 482831 | 0.3059879 | 267380.8 | 14.30693 | 35.51234 | 7 | 2.8 |
| 25.5 | 0.02778 | 0.27785 | 2.46875 | 21.43548 | 2.54787 | 26.35881 | 0.356 | 482831 | 0.3059879 | 267380.8 | 14.30693 | 35.51234 | 7 | 2.8 |
| 24.0 | 0.02778 | 0.27785 | 2.46875 | 21.43548 | 2.54787 | 26.35881 | 0.356 | 482831 | 0.3059879 | 267380.8 | 14.30693 | 35.51234 | 7 | 2.8 |
| 24.0 | 0.02778 | 0.27785 | 2.46875 | 21.43548 | 2.54787 | 26.35881 | 0.356 | 482831 | 0.3059879 | 267380.8 | 14.30693 | 35.51234 | 7 | 2.8 |
| 23.5 | 0.02778 | 0.27785 | 2.46875 | 21.43548 | 2.54787 | 26.35881 | 0.356 | 482831 | 0.3059879 | 267380.8 | 14.30693 | 35.51234 | 7 | 2.8 |
| 22.5 | 0.02778 | 0.27785 | 2.46875 | 21.43548 | 2.54787 | 26.35881 | 0.356 | 482831 | 0.3059879 | 267380.8 | 14.30693 | 35.51234 | 7 | 2.8 |
| 22.5 | 0.02778 | 0.27785 | 2.46875 | 21.43548 | 2.54787 | 26.35881 | 0.356 | 482831 | 0.3059879 | 267380.8 | 14.30693 | 35.51234 | 7 | 2.8 |
Po wstępnym przetwarzaniu, zbiór obserwacji śledzi składa się z 42488 rekordów oraz 15 atrybutów.
dim(sledzie_df)
## [1] 42488 15
Podstawowe statystyki dla atrybutów zbioru:
kable(summary(sledzie_df)) %>%
kable_styling("striped") %>%
scroll_box(height="425px")
| length | cfin1 | cfin2 | chel1 | chel2 | lcop1 | lcop2 | fbar | recr | cumf | totaln | sst | sal | xmonth | nao | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Min. :19.0 | Min. : 0.0000 | Min. : 0.0000 | Min. : 0.000 | Min. : 5.238 | Min. : 0.3074 | Min. : 7.849 | Min. :0.0680 | Min. : 140515 | Min. :0.06833 | Min. : 144137 | Min. :12.77 | Min. :35.40 | Min. : 1.000 | Min. :-4.89000 | |
| 1st Qu.:24.0 | 1st Qu.: 0.0000 | 1st Qu.: 0.2778 | 1st Qu.: 2.469 | 1st Qu.:13.427 | 1st Qu.: 2.5479 | 1st Qu.:17.808 | 1st Qu.:0.2270 | 1st Qu.: 360061 | 1st Qu.:0.14809 | 1st Qu.: 306068 | 1st Qu.:13.60 | 1st Qu.:35.51 | 1st Qu.: 5.000 | 1st Qu.:-1.90000 | |
| Median :25.5 | Median : 0.1111 | Median : 0.7012 | Median : 5.750 | Median :21.435 | Median : 7.0000 | Median :24.859 | Median :0.3320 | Median : 421391 | Median :0.23191 | Median : 539558 | Median :13.86 | Median :35.51 | Median : 8.000 | Median : 0.20000 | |
| Mean :25.3 | Mean : 0.4457 | Mean : 2.0269 | Mean :10.016 | Mean :21.197 | Mean : 12.8386 | Mean :28.396 | Mean :0.3306 | Mean : 519877 | Mean :0.22987 | Mean : 515082 | Mean :13.87 | Mean :35.51 | Mean : 7.252 | Mean :-0.09642 | |
| 3rd Qu.:26.5 | 3rd Qu.: 0.3333 | 3rd Qu.: 1.7936 | 3rd Qu.:11.500 | 3rd Qu.:27.193 | 3rd Qu.: 21.2315 | 3rd Qu.:37.232 | 3rd Qu.:0.4650 | 3rd Qu.: 724151 | 3rd Qu.:0.29803 | 3rd Qu.: 730351 | 3rd Qu.:14.16 | 3rd Qu.:35.52 | 3rd Qu.: 9.000 | 3rd Qu.: 1.63000 | |
| Max. :32.5 | Max. :37.6667 | Max. :19.3958 | Max. :75.000 | Max. :57.706 | Max. :115.5833 | Max. :68.736 | Max. :0.8490 | Max. :1565890 | Max. :0.39801 | Max. :1015595 | Max. :14.73 | Max. :35.61 | Max. :12.000 | Max. : 5.08000 |
Interpretacja atrybutu: długość złowionego śledzia [cm]
Podstawowe statystyki:
length <- data.frame(length=sledzie_df$length)
kable(summary(length)) %>%
kable_styling("striped")
| length | |
|---|---|
| Min. :19.0 | |
| 1st Qu.:24.0 | |
| Median :25.5 | |
| Mean :25.3 | |
| 3rd Qu.:26.5 | |
| Max. :32.5 |
W całym zbiorze znajduje się 55 różnych wartości atrybutu.
nrow(distinct(length))
## [1] 55
Histogram rozkładu występowania wartości w zbiorze:
ggplot(length, aes(x=length, fill="#2c7fb8")) + geom_histogram(binwidth = 0.5) + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")
Interpretacja atrybutu: dostępność planktonu [zagęszczenie Calanus finmarchicus gat. 1]
Podstawowe statystyki:
cfin1 <- data.frame(cfin1=sledzie_df$cfin1)
kable(summary(cfin1)) %>%
kable_styling("striped")
| cfin1 | |
|---|---|
| Min. : 0.0000 | |
| 1st Qu.: 0.0000 | |
| Median : 0.1111 | |
| Mean : 0.4457 | |
| 3rd Qu.: 0.3333 | |
| Max. :37.6667 |
W całym zbiorze znajduje się 39 różnych wartości atrybutu.
nrow(distinct(cfin1))
## [1] 39
Histogram rozkładu występowania wartości w zbiorze:
ggplot(cfin1, aes(x=cfin1, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")
Interpretacja atrybutu: dostępność planktonu [zagęszczenie Calanus finmarchicus gat. 2]
Podstawowe statystyki:
cfin2 <- data.frame(cfin2=sledzie_df$cfin2)
kable(summary(cfin2)) %>%
kable_styling("striped")
| cfin2 | |
|---|---|
| Min. : 0.0000 | |
| 1st Qu.: 0.2778 | |
| Median : 0.7012 | |
| Mean : 2.0269 | |
| 3rd Qu.: 1.7936 | |
| Max. :19.3958 |
W całym zbiorze znajduje się 48 różnych wartości atrybutu.
nrow(distinct(cfin2))
## [1] 48
Histogram rozkładu występowania wartości w zbiorze:
ggplot(cfin2, aes(x=cfin2, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")
Interpretacja atrybutu: dostępność planktonu [zagęszczenie Calanus helgolandicus gat. 1]
Podstawowe statystyki:
chel1 <- data.frame(chel1=sledzie_df$chel1)
kable(summary(chel1)) %>%
kable_styling("striped")
| chel1 | |
|---|---|
| Min. : 0.000 | |
| 1st Qu.: 2.469 | |
| Median : 5.750 | |
| Mean :10.016 | |
| 3rd Qu.:11.500 | |
| Max. :75.000 |
W całym zbiorze znajduje się 48 różnych wartości atrybutu.
nrow(distinct(chel1))
## [1] 48
Histogram rozkładu występowania wartości w zbiorze:
ggplot(chel1, aes(x=chel1, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")
Interpretacja atrybutu: dostępność planktonu [zagęszczenie Calanus helgolandicus gat. 2]
Podstawowe statystyki:
chel2 <- data.frame(chel2=sledzie_df$chel2)
kable(summary(chel2)) %>%
kable_styling("striped")
| chel2 | |
|---|---|
| Min. : 5.238 | |
| 1st Qu.:13.427 | |
| Median :21.435 | |
| Mean :21.197 | |
| 3rd Qu.:27.193 | |
| Max. :57.706 |
W całym zbiorze znajduje się 51 różnych wartości atrybutu.
nrow(distinct(chel2))
## [1] 51
Histogram rozkładu występowania wartości w zbiorze:
ggplot(chel2, aes(x=chel2, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")
Interpretacja atrybutu: dostępność planktonu [zagęszczenie widłonogów gat. 1]
Podstawowe statystyki:
lcop1 <- data.frame(lcop1=sledzie_df$lcop1)
kable(summary(lcop1)) %>%
kable_styling("striped")
| lcop1 | |
|---|---|
| Min. : 0.3074 | |
| 1st Qu.: 2.5479 | |
| Median : 7.0000 | |
| Mean : 12.8386 | |
| 3rd Qu.: 21.2315 | |
| Max. :115.5833 |
W całym zbiorze znajduje się 48 różnych wartości atrybutu.
nrow(distinct(lcop1))
## [1] 48
Histogram rozkładu występowania wartości w zbiorze:
ggplot(lcop1, aes(x=lcop1, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")
Interpretacja atrybutu: dostępność planktonu [zagęszczenie widłonogów gat. 2]
Podstawowe statystyki:
lcop2 <- data.frame(lcop2=sledzie_df$lcop2)
kable(summary(lcop2)) %>%
kable_styling("striped")
| lcop2 | |
|---|---|
| Min. : 7.849 | |
| 1st Qu.:17.808 | |
| Median :24.859 | |
| Mean :28.396 | |
| 3rd Qu.:37.232 | |
| Max. :68.736 |
W całym zbiorze znajduje się 51 różnych wartości atrybutu.
nrow(distinct(lcop2))
## [1] 51
Histogram rozkładu występowania wartości w zbiorze:
ggplot(lcop2, aes(x=lcop2, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")
Interpretacja atrybutu: natężenie połowów w regionie [ułamek pozostawionego narybku]
Podstawowe statystyki:
fbar <- data.frame(fbar=sledzie_df$fbar)
kable(summary(fbar)) %>%
kable_styling("striped")
| fbar | |
|---|---|
| Min. :0.0680 | |
| 1st Qu.:0.2270 | |
| Median :0.3320 | |
| Mean :0.3306 | |
| 3rd Qu.:0.4650 | |
| Max. :0.8490 |
W całym zbiorze znajduje się 51 różnych wartości atrybutu.
nrow(distinct(fbar))
## [1] 51
Histogram rozkładu występowania wartości w zbiorze:
ggplot(fbar, aes(x=fbar, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")
Interpretacja atrybutu: roczny narybek [liczba śledzi]
Podstawowe statystyki:
recr <- data.frame(recr=sledzie_df$recr)
kable(summary(recr)) %>%
kable_styling("striped")
| recr | |
|---|---|
| Min. : 140515 | |
| 1st Qu.: 360061 | |
| Median : 421391 | |
| Mean : 519877 | |
| 3rd Qu.: 724151 | |
| Max. :1565890 |
W całym zbiorze znajduje się 52 różnych wartości atrybutu.
nrow(distinct(recr))
## [1] 52
Histogram rozkładu występowania wartości w zbiorze:
ggplot(recr, aes(x=recr, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")
Interpretacja atrybutu: łączne roczne natężenie połowów w regionie [ułamek pozostawionego narybku]
Podstawowe statystyki:
cumf <- data.frame(cumf=sledzie_df$cumf)
kable(summary(cumf)) %>%
kable_styling("striped")
| cumf | |
|---|---|
| Min. :0.06833 | |
| 1st Qu.:0.14809 | |
| Median :0.23191 | |
| Mean :0.22987 | |
| 3rd Qu.:0.29803 | |
| Max. :0.39801 |
W całym zbiorze znajduje się 52 różnych wartości atrybutu.
nrow(distinct(cumf))
## [1] 52
Histogram rozkładu występowania wartości w zbiorze:
ggplot(cumf, aes(x=cumf, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")
Interpretacja atrybutu: łączna liczba ryb złowionych w ramach połowu [liczba śledzi]
Podstawowe statystyki:
totaln <- data.frame(totaln=sledzie_df$totaln)
kable(summary(totaln)) %>%
kable_styling("striped")
| totaln | |
|---|---|
| Min. : 144137 | |
| 1st Qu.: 306068 | |
| Median : 539558 | |
| Mean : 515082 | |
| 3rd Qu.: 730351 | |
| Max. :1015595 |
W całym zbiorze znajduje się 53 różnych wartości atrybutu.
nrow(distinct(totaln))
## [1] 53
Histogram rozkładu występowania wartości w zbiorze:
ggplot(totaln, aes(x=totaln, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")
Interpretacja atrybutu: temperatura przy powierzchni wody [°C]
Podstawowe statystyki:
sst <- data.frame(sst=sledzie_df$sst)
kable(summary(sst)) %>%
kable_styling("striped")
| sst | |
|---|---|
| Min. :12.77 | |
| 1st Qu.:13.60 | |
| Median :13.86 | |
| Mean :13.87 | |
| 3rd Qu.:14.16 | |
| Max. :14.73 |
W całym zbiorze znajduje się 51 różnych wartości atrybutu.
nrow(distinct(sst))
## [1] 51
Histogram rozkładu występowania wartości w zbiorze:
ggplot(sst, aes(x=sst, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")
Interpretacja atrybutu: poziom zasolenia wody [Knudsen ppt]
Podstawowe statystyki:
sal <- data.frame(sal=sledzie_df$sal)
kable(summary(sal)) %>%
kable_styling("striped")
| sal | |
|---|---|
| Min. :35.40 | |
| 1st Qu.:35.51 | |
| Median :35.51 | |
| Mean :35.51 | |
| 3rd Qu.:35.52 | |
| Max. :35.61 |
W całym zbiorze znajduje się 51 różnych wartości atrybutu.
nrow(distinct(sal))
## [1] 51
Histogram rozkładu występowania wartości w zbiorze:
ggplot(sal, aes(x=sal, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")
Interpretacja atrybutu: miesiąc połowu [numer miesiąca]
Podstawowe statystyki:
xmonth <- data.frame(xmonth=sledzie_df$xmonth)
kable(summary(xmonth)) %>%
kable_styling("striped")
| xmonth | |
|---|---|
| Min. : 1.000 | |
| 1st Qu.: 5.000 | |
| Median : 8.000 | |
| Mean : 7.252 | |
| 3rd Qu.: 9.000 | |
| Max. :12.000 |
W całym zbiorze znajduje się 12 różnych wartości atrybutu.
nrow(distinct(xmonth))
## [1] 12
Histogram rozkładu występowania wartości w zbiorze:
ggplot(xmonth, aes(x=xmonth, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")
Interpretacja atrybutu: oscylacja północnoatlantycka [mb] Podstawowe statystyki:
nao <- data.frame(nao=sledzie_df$nao)
kable(summary(nao)) %>%
kable_styling("striped")
| nao | |
|---|---|
| Min. :-4.89000 | |
| 1st Qu.:-1.90000 | |
| Median : 0.20000 | |
| Mean :-0.09642 | |
| 3rd Qu.: 1.63000 | |
| Max. : 5.08000 |
W całym zbiorze znajduje się 45 różnych wartości atrybutu.
nrow(distinct(nao))
## [1] 45
Histogram rozkładu występowania wartości w zbiorze:
ggplot(nao, aes(x=nao, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")
| rowname | variable | correlation |
|---|---|---|
| lcop1 | chel1 | 0.9559048 |
| lcop2 | chel2 | 0.8863132 |
| cumf | fbar | 0.8167639 |
| totaln | cumf | -0.7083475 |
| lcop2 | cfin2 | 0.6537200 |
| nao | lcop1 | -0.5508237 |
| nao | sst | 0.5121196 |
| totaln | fbar | -0.5081649 |
| nao | chel1 | -0.5059630 |
| sst | length | -0.4516706 |
| nao | totaln | -0.3889789 |
| totaln | chel2 | -0.3769579 |
| totaln | recr | 0.3688198 |
| cumf | cfin2 | 0.3377041 |
| chel2 | cfin2 | 0.3080353 |
| totaln | lcop2 | -0.3041920 |
| cumf | lcop2 | 0.2920843 |
| sst | totaln | -0.2865169 |
| chel2 | chel1 | 0.2859222 |
| sal | recr | 0.2790503 |
| totaln | lcop1 | 0.2674522 |
| sst | lcop1 | -0.2654202 |
| cumf | chel2 | 0.2628982 |
| cumf | recr | -0.2574990 |
| fbar | length | 0.2569714 |
| nao | length | -0.2568447 |
| lcop2 | chel1 | 0.2479366 |
| sst | cfin2 | -0.2384297 |
| lcop1 | length | 0.2377540 |
| recr | fbar | -0.2355175 |
| nao | cumf | 0.2271715 |
| sal | chel2 | -0.2237467 |
| chel1 | length | 0.2209123 |
| totaln | cfin2 | -0.2183760 |
| sst | chel1 | -0.2166129 |
| lcop2 | cfin1 | 0.2095303 |
| chel2 | cfin1 | 0.2020157 |
| sst | recr | -0.1959423 |
| sal | lcop2 | -0.1866686 |
| sst | fbar | -0.1808185 |
| lcop1 | chel2 | 0.1748005 |
| totaln | chel1 | 0.1676148 |
| fbar | chel1 | 0.1588357 |
| fbar | cfin2 | 0.1531482 |
| cfin2 | cfin1 | 0.1511962 |
| lcop2 | lcop1 | 0.1502862 |
| sal | totaln | 0.1491850 |
| sal | chel1 | -0.1475639 |
| sal | cfin1 | 0.1271426 |
| totaln | cfin1 | 0.1268702 |
| nao | sal | 0.1243848 |
| lcop1 | cfin1 | 0.1226292 |
| sst | lcop2 | -0.1197329 |
| recr | cfin1 | 0.1183971 |
| sal | cumf | -0.1031681 |
| recr | cfin2 | -0.1017753 |
| sal | lcop1 | -0.0998841 |
| cfin2 | length | 0.0983251 |
| totaln | length | 0.0960581 |
| chel1 | cfin1 | 0.0954064 |
| fbar | lcop1 | 0.0938339 |
| nao | recr | 0.0928312 |
| sal | cfin2 | -0.0841898 |
| cfin1 | length | 0.0812255 |
| xmonth | chel2 | 0.0744084 |
| nao | fbar | 0.0665154 |
| cumf | chel1 | 0.0656935 |
| xmonth | lcop2 | 0.0649399 |
| fbar | cfin1 | -0.0641339 |
| nao | chel2 | -0.0583287 |
| fbar | lcop2 | 0.0524222 |
| lcop2 | length | 0.0489433 |
| cumf | cfin1 | -0.0478946 |
| recr | chel1 | -0.0460700 |
| xmonth | chel1 | 0.0455077 |
| nao | lcop2 | -0.0445032 |
| lcop1 | cfin2 | -0.0399855 |
| sal | fbar | 0.0394580 |
| xmonth | cumf | 0.0358907 |
| sal | length | 0.0322355 |
| xmonth | lcop1 | 0.0302401 |
| xmonth | totaln | -0.0295287 |
| sst | cumf | 0.0286103 |
| fbar | chel2 | 0.0268957 |
| xmonth | sal | -0.0253567 |
| xmonth | recr | 0.0186172 |
| xmonth | cfin2 | 0.0174752 |
| chel2 | length | -0.0143077 |
| cumf | lcop1 | -0.0142024 |
| xmonth | length | 0.0137120 |
| xmonth | cfin1 | 0.0131103 |
| cumf | length | 0.0115254 |
| sst | chel2 | 0.0104905 |
| sal | sst | 0.0104314 |
| recr | length | -0.0103424 |
| sst | cfin1 | 0.0083659 |
| xmonth | fbar | 0.0082185 |
| nao | cfin2 | -0.0071064 |
| xmonth | sst | -0.0068109 |
| nao | cfin1 | 0.0056202 |
| recr | lcop1 | 0.0054818 |
| chel1 | cfin2 | -0.0033534 |
| recr | chel2 | 0.0013704 |
| nao | xmonth | -0.0011103 |
| recr | lcop2 | -0.0005898 |
Wykres przedstawia graficzną reprezentację powyższej tabeli. Im silniejszy związek, tym ciemniejszy jest kolor na przecięciu dwóch zmiennych.
cor_plot <- data.frame(cor_matrix) %>%
rownames_to_column() %>%
pivot_longer(-rowname, names_to="colname") %>%
ggplot(aes(rowname, colname, fill = value)) +
geom_tile() +
scale_fill_gradient2() +
theme(axis.text.x = element_text(angle = 90),
axis.title.x = element_blank(),
axis.title.y=element_blank(),
axis.text.y=element_blank(),
axis.ticks.y=element_blank()) + coord_flip()
ggplotly(cor_plot)
Warto zwrócić uwagę na pierwszy rząd, reprezentujący korelacje ze zmienną ‘xmonth’, informującą o miesiącu połowu śledzia. Jego korelacja ze wszystkimi innymi atrybutami jest bliska zeru, co świadczy o braku zależności liniowej pomiędzy porą roku, a warunkami występującymi w morzu oraz częstością połowów przez ludzi.
plot_data <- sledzie_df %>%
mutate(row_index=1:nrow(sledzie_df) %/% 50) %>%
group_by(row_index) %>%
summarise(mean_length=mean(length))
p <- ggplot(plot_data, aes(x=row_index, y=mean_length)) + geom_point(aes(alpha=0.01)) + geom_smooth() + labs(x="Upływ czasu", y="Średnia długość") + theme(axis.text.x=element_blank(), axis.ticks.x=element_blank())
ggplotly(p)
Średnia długość śledzia wraz z kolejnymi pomiarami zaczęła najpierw rosnąć, a następnie od około 1/3 do końca pomiarów monotonicznie maleć. Przy tworzeniu wykresu założono, że dane w zbiorze zostały uzupełniane w sposób przyrostowy. W celu uproszczenia wykresu oraz uogólnienia trendu, wykonane zostało uśrednienie wartości długości śledzia dla grup 50 kolejnych śledzi.
Dane wejściowe zostały podzielone na dane uczące (75%), walidujące i testowe.
inTraining <- createDataPartition(
y = sledzie_df$length,
# procent w zbiorze uczącym
p = .75,
list = FALSE
)
training <- sledzie_df[inTraining, ]
testing <- sledzie_df[-inTraining, ]
Wykonana została powtórzona ocena krzyżowa.
ctrl <- trainControl(
# powtórzona ocena krzyżowa
method = "repeatedcv",
# liczba podziałów
number = 2,
# liczba powtórzeń
repeats = 5,
search="random"
)
W budowie regresora zastosowany został algorytm Random forest. Użyta została optymalizacja parametrów w celu uzyskania możliwie najlepszych wyników.
rfGrid <- expand.grid(mtry = 2:5)
fitTune <- train(
length ~ .,
data = training,
method = "rf",
trControl = ctrl,
tuneGrid = rfGrid,
# Paramter dla algorytmu uczącego
ntree = 30
)
fitTune
## Random Forest
##
## 31868 samples
## 14 predictor
##
## No pre-processing
## Resampling: Cross-Validated (2 fold, repeated 5 times)
## Summary of sample sizes: 15933, 15935, 15934, 15934, 15934, 15934, ...
## Resampling results across tuning parameters:
##
## mtry RMSE Rsquared MAE
## 2 1.172179 0.4961002 0.9266149
## 3 1.166325 0.5011428 0.9216823
## 4 1.161063 0.5056256 0.9170422
## 5 1.156562 0.5094468 0.9129805
##
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was mtry = 5.
Zgodnie z powyższymi informacjami z wyniku uczenia, wybrany został model dla wartości <> parametru mtry. Miara RMSE oraz R^2 dla zbioru walidującego to odpowiednio: <> oraz <>.
predictions <- predict(fitTune, newdata = testing)
results <- data.frame(predictions=predictions, testing=testing$length)
ggplot(results, aes(x=1:nrow(results), y=testing - predictions)) + geom_point() + labs(x="Kolejne obserwacje w zbiorze testowym", y="Odchylenie od danych testowych")
Po zbudowaniu modelu, został on przetestowany na zbiorze testowym. Powyższy wykres przedstawia różnice między wartością oczekiwaną, a przewidzianą przez algorytm.
errors <- data.frame(errors = results$testing - results$predictions)
ggplot(errors, aes(x=errors)) + geom_histogram(binwidth = 0.25) + labs(x="Różnica", y="Liczność")
Jak możemy zauważyć na kolejnym wykresie, liczność poszczególnych błędów układa się w kształt zbliżony do rozkładu normalnego, ze środkiem w punkcie 0.
total = length(errors[, 1])
mean = mean(errors[, 1])
sd = sd(errors[, 1])
pData <- function(nSD){
lo = mean - nSD/2*sd
hi = mean + nSD/2*sd
percent = sum(errors[, 1]>=lo & errors[, 1]<=hi)/total *100
percent
}
Procent danych w przedziale jednego, dwóch oraz trzech odchyleń standardowych to odpowiednio: 38%, 69.42% oraz 87.23%.
RMSE(results$predictions, results$testing)
## [1] 1.156587
Miara RMSE dla zbioru testowego to: 1.1565871
rsq <- function(x, y) {
cor(x, y) ^ 2
}
rsq(results$predictions, results$testing)
## [1] 0.5055137
Miara R^2 dla zbioru testowego to: 0.5055137
ggplot(varImp(fitTune))
Ekstraktując ważności atrybutów z modelu, możemy zauważyć że zdecydowanie wyróżniającym się jest sst - temperatura przy powierzchni wody. Kolejnymi zauważalnie większymi od pozostałych są fbar - natężenie połowów w regionie oraz totaln - łączna liczba ryb złowionych w ramach połowu. Intuicja podpowiada nam, że jest to logiczne i uzasadnialne. Wraz ze wzrostem temperatury, zmieniają się parametry środowiska życia śledzi, co może przekładać się na pogorszenie warunkóW ich bytowania i w konsekwencji utrudniony wzrost. Liczba wyłowionych przez ludzi ryb jest również kluczowa, ponieważ śledzie mają mniej czasu na odbudowanie populacji i dorośnięcie do odpowiednich rozmiaróW Pozostałe atrybuty zostały sklasyfikowane jako te, o małym znaczeniu w porównaniu do wcześniej wymienionych.
Poniższe wykresy są porównaniem 3 atrybutów z największym znaczeniem wraz ze średnią długością sledzia. Możemy na nich zauważyć korelacje pomiędzy zmianami wielkości ryb, a pozostałymi zmiennymi.